home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / cdrom / cdplay.zip / ROMPLAY2.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-07-15  |  16.5 KB  |  316 lines
  1. 1 REM SAVE"ROMPLAY2.bas",A
  2. 10 GOSUB 10000:GOTO 9000
  3. 1000 ACK=INP(PRTB) AND 3:IF ACK=2 THEN RETURN ELSE L=L+1:IF L<1400 THEN 1000 ELSE 8070
  4. 1050 ACK=INP(PRTB) AND 3:IF ACK=2 THEN OUT PRTC,NOCMD:RETURN
  5. 1060 L=L+1:IF L<1025 THEN 1050 ELSE 8070
  6. 2000 OUT DIRPRT,OTCMD:RETURN :' \ OutDir
  7. 2999 ' \ ClrCmdC
  8. 3000 L=0:OUT PRTC,NOCMD:OUT PRTA,255:OUT PRTC,CMD:GOSUB 1050:RETURN
  9. 3010 GOSUB 3500:BUSY=CSTAT AND 1:IF BUSY<1 THEN RETURN ELSE 3010
  10. 3199 ' \ TracPlay
  11. 3200 GOSUB 3000:OUT PRTA,232 OR CHANNELS:OUT PRTC,CMD:GOSUB 1050
  12. 3210 OUT PRTA,STRAC:OUT PRTC,CMD:GOSUB 1050
  13. 3220 OUT PRTA,ETRAC:OUT PRTC,CMD:GOSUB 1050:GOSUB 3010:RETURN
  14. 3299 ' \ TimePlay
  15. 3300 GOSUB 3000:OUT PRTA,224 OR CHANNELS:OUT PRTC,CMD:GOSUB 1050:FOR X=1 TO 6
  16. 3310 OUT PRTA,PTIM(X):OUT PRTC,CMD:GOSUB 1050:NEXT X:GOSUB 3010:RETURN
  17. 3399 ' \ DStat
  18. 3400 GOSUB 3000:OUT PRTA,96:OUT PRTC,CMD:GOSUB 1050:OUT DIRPRT,NCMD
  19. 3410 OUT PRTC,DMC:GOSUB 1000:DSTAT=INP(PRTA):OUT PRTC,NOCMD:GOSUB 2000:RETURN
  20. 3499 ' \ CStat
  21. 3500 GOSUB 3000:OUT PRTA,112:OUT PRTC,CMD:GOSUB 1050:OUT DIRPRT,NCMD
  22. 3510 OUT PRTC,DMC:GOSUB 1000:CSTAT=INP(PRTA):OUT PRTC,NOCMD:GOSUB 2000:RETURN
  23. 3549 ' \ LStat
  24. 3550 GOSUB 3000:OUT PRTA,160:OUT PRTC,CMD:GOSUB 1050:OUT DIRPRT,NCMD
  25. 3560 OUT PRTC,DMC:GOSUB 1000:LSTAT=INP(PRTA):OUT PRTC,NOCMD:GOSUB 2000:RETURN
  26. 3599 ' \ Q@
  27. 3600 GOSUB 3000:OUT PRTA,80:OUT PRTC,CMD:GOSUB 1050:OUT DIRPRT,NCMD
  28. 3650 FOR Q=1 TO 10:OUT PRTC,DMC:GOSUB 1000:QCODE(Q)=INP(PRTA):OUT PRTC,NODMC:NEXT Q:GOSUB 2000:RETURN
  29. 3699 ' \ ID@
  30. 3700 GOSUB 3000:OUT PRTA,48:OUT PRTC,CMD:GOSUB 1050
  31. 3710 OUT PRTA,144:OUT PRTC,CMD:GOSUB 1050:OUT PRTA,144:OUT PRTC,CMD:GOSUB 1050
  32. 3720 OUT PRTA,133:OUT PRTC,CMD:GOSUB 1050:OUT DIRPRT,NCMD:FOR Q=1 TO 52
  33. 3730 OUT PRTC,DMC:GOSUB 1000:ID(Q)=INP(PRTA):OUT PRTC,NODMC:NEXT Q:GOSUB 2000:RETURN
  34. 3800 GOSUB 3000:OUT PRTA,24:OUT PRTC,CMD:GOSUB 1050:GOSUB 3010:RETURN:' \ Paws
  35. 3810 GOSUB 3000:OUT PRTA,16:OUT PRTC,CMD:GOSUB 1050:' \ Seek
  36. 3820 FOR X=1 TO 3:OUT PRTA,PTIM(X):OUT PRTC,CMD:GOSUB 1050:NEXT X:GOSUB 3010:RETURN
  37. 3900 GOSUB 3000:OUT PRTA,0:OUT PRTC,CMD:GOSUB 1050:RETURN:' \ Reset
  38. 3910 GOSUB 3000:OUT PRTA,169:OUT PRTC,CMD:GOSUB 1050:RETURN:' Lock
  39. 3920 GOSUB 3000:OUT PRTA,48:OUT PRTC,CMD:GOSUB 1050:' \ Eat
  40. 3930 OUT PRTA,129:OUT PRTC,CMD:GOSUB 1050:GOSUB 3010:RETURN
  41. 3950 GOSUB 3000:OUT PRTA,168:OUT PRTC,CMD:GOSUB 1050:RETURN:' \ Kcol
  42. 3960 GOSUB 3000:OUT PRTA,48:OUT PRTC,CMD:GOSUB 1050:' \ Eject
  43. 3970 OUT PRTA,128:OUT PRTC,CMD:GOSUB 1050:GOSUB 3010:RETURN
  44. 4000 GOSUB 3400:K$=INKEY$:IF K$<>"" OR DSTAT>7 THEN RETURN
  45. 4100 GOSUB 3600:NQ=QCODE(9):IF NQ=TQ THEN 4000
  46. 4110 QMODE=QCODE(1) AND 15:IF QMODE=1 THEN TQ=NQ:GOSUB 4200
  47. 4120 GOTO 4000
  48. 4200 QCTL=QCODE(1) AND 240:IF QCTL<64 THEN TINK=INK ELSE TINK=YELLOW
  49. 4210 COLOR TINK:LOCATE 9,41:BCD=QCODE(2):GOSUB 5050:PRINT DEC;"  ";
  50. 4220 LOCATE 10,41:BCD=QCODE(3):GOSUB 5050
  51. 4230 PRINT DEC;"  ";
  52. 4240 BCD=QCODE(8):GOSUB 5050:NPOS=DEC:IF NPOS>MPOS THEN NPOS=MPOS
  53. 4250 LOCATE 11,41:PRINT DEC;"  ";
  54. 4260 LOCATE 12,41:BCD=QCODE(9):GOSUB 5050:PRINT DEC;" ";
  55. 4400 COLOR WHITE,HOLE:IF NPOS<>OPOS THEN LOCATE SPOS,OPOS+1:PRINT SCALE$;
  56. 4410 COLOR TIP:LOCATE SPOS,NPOS+1:PRINT TIP$;:OPOS=NPOS:COLOR TINK,PAPER:RETURN
  57. 4999 ' \ >BCD
  58. 5000 D1=INT(DEC/10):D1=D1*16:D2=DEC MOD 10:BCD=D1 OR D2:RETURN
  59. 5049 ' \ <BCD  Mask 240=11110000 15=00001111
  60. 5050 D1=BCD AND 240:D1=D1/16:D1=D1*10:D2=BCD AND 15:DEC=D2+D1:RETURN
  61. 5100 FOR X=1 TO 6:PTIM(X)=MTIM(X):NEXT:RETURN
  62. 5200 GOSUB 3600:QMODE=QCODE(1) AND 15:IF QMODE>1 THEN 5200:' \ Gtime
  63. 5210 RETURN
  64. 5500 GOSUB 9600:IF OLDDISC=1 THEN RETURN: ' \ >MaxMin
  65. 5502 GOSUB 9860:GOSUB 3910:GOSUB 5100:GOSUB 9460:MQUE=1:QUE(1)=0:QFLAG=0:OPOS=0
  66. 5510 GOSUB 9740:CHANNELS=3:MAXM=0:C=94:INC=-5:COLOR INK
  67. 5520 DEC=C:GOSUB 5000:PTIM(1)=BCD:GOSUB 5550:IF INC=1 AND DSTAT=8 THEN 5570
  68. 5530 LOCATE 6,41:PRINT C;:C=C+INC:IF C<0 THEN C=0:INC=1
  69. 5532 IF C>99 THEN RETURN
  70. 5540 GOTO 5520
  71. 5550 GOSUB 3300:GOSUB 3400:IF DSTAT=4 THEN INC=1:' ?Play
  72. 5560 RETURN
  73. 5570 IF C>1 THEN MAXM=C-1
  74. 5580 DEC=MAXM:GOSUB 5000:PTIM(1)=BCD:MPOS=MAXM:IF MAXM>79 THEN MPOS=79
  75. 5590 COLOR WHITE,HOLE:FOR X=0 TO MPOS:LOCATE SPOS,X+1:PRINT SCALE$;:NEXT:COLOR INK,PAPER
  76. 5600 INC=-3:C=56:MAXS=0:' >MaxSec
  77. 5610 DEC=C:GOSUB 5000:PTIM(2)=BCD:LOCATE 7,41:PRINT C;"  ";
  78. 5620 GOSUB 5550:IF INC=1 AND DSTAT=8 THEN 5650
  79. 5630 C=C+INC:IF C<0 THEN C=0:INC=1
  80. 5632 IF C>60 THEN RETURN
  81. 5640 GOTO 5610
  82. 5650 IF C>1 THEN MAXS=C-1
  83. 5660 ASEC=C-2:IF ASEC<0 THEN ASEC=ASEC+59:DEC=MAXM-1:GOSUB 5000:PTIM(1)=BCD
  84. 5670 DEC=ASEC:GOSUB 5000:PTIM(2)=BCD:GOSUB 3300
  85. 5680 GOSUB 5200:BCD=QCODE(2):GOSUB 5050:MAXTRAC=DEC
  86. 5690 LOCATE 5,41:PRINT MAXTRAC;"  ";:CHANNELS=0:OLDDISC=1
  87. 5692 IF HTIM(1)>0 THEN FOR X=1 TO 3:PTIM(X)=HTIM(X):NEXT:GOSUB 3300
  88. 5694 RETURN
  89. 6000 K$=INKEY$:IF K$="" THEN 6000
  90. 6010 K=ASC(K$):RETURN
  91. 6200 IF K>47 AND K<58 THEN WK$=K$ ELSE WK$=""
  92. 6210 LOCATE 23,48:PRINT WK$;"  ";
  93. 6220 GOSUB 6000:IF K=8 THEN WK$="" ELSE IF K=13 THEN RETURN
  94. 6230 IF K>47 AND K<58 THEN WK$=WK$+K$:IF LEN(WK$)>2 THEN 6200
  95. 6240 IF K=32 THEN K$="":RETURN
  96. 6250 GOTO 6210
  97. 6300 GOSUB 7060:' \ SlideCue
  98. 6310 IF LEN(K$)<2 THEN GOSUB 6400:RETURN
  99. 6320 K$=RIGHT$(K$,1):IF K$="M" THEN NPOS=OPOS+1:IF NPOS>MPOS THEN NPOS=0
  100. 6330 IF K$="K" THEN NPOS=OPOS-1:IF NPOS<0 THEN NPOS=MPOS
  101. 6350 DEC=NPOS:GOSUB 4400:LOCATE 11,41:PRINT NPOS;"  ";
  102. 6360 IF K$="P" THEN GOSUB 6400:RETURN
  103. 6370 IF K$="H" THEN GOSUB 6390
  104. 6380 GOSUB 6000:GOTO 6310
  105. 6390 GOSUB 5000:GOSUB 5100:PTIM(1)=BCD:PTIM(2)=1:GOSUB 3810:GOSUB 7050:GOSUB 5200:T=NPOS:GOSUB 4200::NPOS=T:GOSUB 9990:RETURN
  106. 6400 K$="":GOSUB 5000:GOSUB 5100:PTIM(1)=BCD:PTIM(2)=0:GOSUB 3300:GOSUB 5200:GOSUB 7060:GOSUB 9990:RETURN
  107. 7050 WF=1:LOCATE 23,37:PRINT "PAUSED":RETURN
  108. 7060 IF QFLAG=1 THEN GOSUB 8700:RETURN
  109. 7070 TIP=YELLOW:GOSUB 4400:FINFLAG=0:RFLAG=0:WF=0:GOSUB 9560:RETURN
  110. 7100 GOSUB 5200:BCD=QCODE(2):GOSUB 5050:DEC=DEC+SKIPDIR:' \ Skip
  111. 7110 IF DEC>MAXTRAC THEN DEC=1 ELSE IF DEC<1 THEN DEC=MAXTRAC
  112. 7120 GOSUB 5000:STRAC=BCD:ETRAC=153:GOSUB 3200:GOSUB 7060:GOSUB 9990:RETURN
  113. 7300 QMODE=QCODE(1) AND 15:IF QMODE>1 THEN GOSUB 5200:' \ SectionPlayBegin
  114. 7310 FOR Q=1 TO 3:RTIM(Q)=QCODE(Q+7):NEXT Q:RETURN
  115. 7400 QMODE=QCODE(1) AND 15:IF QMODE>1 THEN GOSUB 5200:' \ Finish
  116. 7410 FOR Q=4 TO 6:RTIM(Q)=QCODE(Q+4):NEXT Q:FINFLAG=1
  117. 7420 IF RTIM(1)>RTIM(4) THEN GOSUB 7060:RETURN
  118. 7430 IF RTIM(1)=RTIM(4) THEN IF RTIM(2)>=RTIM(5) THEN GOSUB 7060:RETURN
  119. 7440 TIP=LCYAN:GOSUB 4400:FOR Q=1 TO 6:PTIM(Q)=RTIM(Q):NEXT Q:RETURN
  120. 7710 IF WF=1 THEN GOTO 7750:' \ Pause
  121. 7720 GOSUB 5200:GOSUB 3800:GOSUB 7050:GOSUB 5100
  122. 7730 PTIM(1)=QCODE(8):PTIM(2)=QCODE(9):PTIM(3)=QCODE(10):RETURN
  123. 7750 GOSUB 3300:GOSUB 7060:RETURN
  124. 7760 IF AFRAME<0 THEN AFRAME=AFRAME+74:ASEC=ASEC-1
  125. 7770 IF ASEC<0 THEN ASEC=ASEC+59:AMIN=AMIN-1
  126. 7780 IF AMIN<0 THEN AMIN=0
  127. 7790 RETURN
  128. 7800 IF WF=1 THEN 7750:' \ Cue
  129. 7810 GOSUB 5200:BCD=QCODE(8):GOSUB 5050:AMIN=DEC:BCD=QCODE(9):GOSUB 5050
  130. 7820 ASEC=DEC:BCD=QCODE(10):GOSUB 5050:AFRAME=DEC
  131. 7830 BCD=QCODE(4):GOSUB 5050:CMIN=DEC:BCD=QCODE(5):GOSUB 5050:CSEC=DEC
  132. 7840 BCD=QCODE(6):GOSUB 5050:CFRAME=DEC
  133. 7850 AMIN=AMIN-CMIN:ASEC=ASEC-CSEC:AFRAME=AFRAME-CFRAME:GOSUB 7760
  134. 7860 GOSUB 5100:DEC=AMIN:GOSUB 5000:PTIM(1)=BCD:DEC=ASEC:GOSUB 5000:PTIM(2)=BCD
  135. 7870 DEC=AFRAME:GOSUB 5000:PTIM(3)=BCD
  136. 7880 GOSUB 3810:GOSUB 7050:GOSUB 4100:RETURN
  137. 7900 GOSUB 5100:GOSUB 5200:BCD=QCODE(8):GOSUB 5050:CMIN=DEC:BCD=QCODE(9):GOSUB 5050:' >>
  138. 7910 DEC=DEC+INC:IF DEC<0 THEN DEC=DEC+59:CMIN=CMIN-1:IF CMIN<0 THEN CMIN=MAXM:IF DEC>MAXS THEN DEC=MAXS-10:IF DEC<0 THEN DEC=DEC+59:CMIN=CMIN-1
  139. 7920 IF DEC>59 THEN DEC=DEC-59:CMIN=CMIN+1
  140. 7922 IF CMIN>MAXM OR CMIN<0 THEN CMIN=0
  141. 7930 GOSUB 5000:PTIM(2)=BCD:DEC=CMIN:GOSUB 5000:PTIM(1)=BCD
  142. 7940 GOSUB 3300:GOSUB 7060:GOSUB 9990:RETURN
  143. 7950 GOSUB 5100:GOSUB 5200:BCD=QCODE(8):GOSUB 5050:AMIN=DEC+INC:IF AMIN<0 THEN AMIN=MAXM:BCD=QCODE(9):GOSUB 5050:IF DEC>MAXS+1 THEN AMIN=AMIN-1:' >>>
  144. 7970 IF AMIN>MAXM OR AMIN<0 THEN AMIN=0
  145. 7980 DEC=AMIN:GOSUB 5000:PTIM(1)=BCD:PTIM(2)=QCODE(9):GOSUB 3300:GOSUB 7060:GOSUB 9990:RETURN
  146. 8000 L=0:ACK=INP(PRTB) AND 3:IF ACK>0 THEN 8100:' \ Drive?
  147. 8002 OUT PRTC,NOCMD:OUT PRTA,255
  148. 8010 L=L+1:IF L=2 THEN GOSUB 8080
  149. 8020 OUT PRTC,CMD
  150. 8030 ACK=INP(PRTB) AND 3:IF ACK=2 THEN GOSUB 8090:RETURN
  151. 8050 IF L<200 THEN 8010
  152. 8060 IF DF=0 THEN DRIVE=DRIVE+1:GOSUB 9890:IF DRIVE<8 THEN 8000 ELSE IF DRIVE=8 THEN DRIVE=0:DF=1:GOTO 8000
  153. 8070 LOCATE 23,25:PRINT "Power On Drive & Press a Key":GOSUB 6000:IF K=27 THEN 9682 ELSE RUN
  154. 8080 COLOR INK+FLASH:LOCATE 23,30:PRINT "Checking for Drive! ";DRIVE:RETURN
  155. 8090 OUT PRTC,NOCMD:GOSUB 9560:GOSUB 9850:RETURN
  156. 8100 LOCATE 20:PRINT "Address Mismatch I/F Card-Program":LIST 10010:END
  157. 8200 GOSUB 8839:LOCATE 22,8:PRINT "< > StepQue  Fill  Clear  Shuffle  Insert  Delete  ToggleMode"
  158. 8210 GOSUB 6000:IF K=13 OR K=32 THEN GOSUB 8250:RETURN
  159. 8220 IF K$<>"" THEN GOSUB 9350:GOSUB 8839
  160. 8230 GOTO 8210
  161. 8250 LOCATE 22,8:FOR X=1 TO 70:PRINT " ";:NEXT X:IF QFLAG=1 THEN RETURN
  162. 8260 LOCATE 14,38:PRINT BLK$:RETURN
  163. 8300 IF MQUE>98 THEN RETURN ELSE GOSUB 9560:PRINT"Add what Track?";
  164. 8302 GOSUB 6200:TUNE=VAL(WK$):IF TUNE>MAXTRAC THEN 8302 ELSE IF TUNE=0 THEN GOSUB 9560:RETURN
  165. 8304 IF QUE(1)=0 THEN QUE(1)=TUNE:GOSUB 8840:GOSUB 9560:RETURN
  166. 8310 MQUE=MQUE+1:QUE(MQUE)=QUE(1):QUE(1)=TUNE:GOSUB 8840:GOSUB 9560:RETURN
  167. 8400 IF MQUE<2 THEN RETURN ELSE GOSUB 9560:PRINT "Num. to Delete?";
  168. 8402 GOSUB 6200:TUNE=VAL(WK$):IF TUNE>MAXTRAC THEN 8402 ELSE IF TUNE=0 THEN GOSUB 9560:RETURN
  169. 8410 TMQUE=MQUE:FOR X=1 TO MQUE:IF QUE(X)=TUNE THEN GOSUB 8450
  170. 8420 NEXT X:MQUE=TMQUE
  171. 8440 GOSUB 8840:GOSUB 9560:RETURN
  172. 8450 IF QUE(X)=TUNE THEN GOSUB 8480:IF TMQUE<X THEN RETURN
  173. 8452 IF QUE(X)=TUNE THEN 8450
  174. 8460 RETURN
  175. 8480 FOR X1=X TO MQUE:QUE(X1)=QUE(X1+1):NEXT X1:TMQUE=TMQUE-1:RETURN
  176. 8500 IF SKIPDIR=1 THEN GOSUB 8820 ELSE GOSUB 8830
  177. 8510 GOSUB 8840:K$="~":RETURN
  178. 8700 LOCATE 14,38:IF QFLAG=1 THEN PRINT BLK$;:QFLAG=0:GOSUB 7070:RETURN:' \ Qoff
  179. 8710 IF QFLAG=0 THEN GOSUB 8839:QFLAG=1:FINFLAG=0:RFLAG=0:TIP=LRED:GOSUB 4400
  180. 8712 IF K$<>"/" THEN RETURN:' Rndplay
  181. 8714 MQUE=MAXTRAC:GOSUB 8720:GOSUB 8730:GOSUB 9400:RETURN
  182. 8720 FOR X=1 TO MQUE:QUE(X)=(MQUE+1)-X:NEXT X:RETURN:' Fillque
  183. 8730 FOR X=1 TO MQUE:TRAN=1+INT(RND(1)*MQUE):TQUE=QUE(TRAN):' Shuffle
  184. 8740 QUE(TRAN)=QUE(X):QUE(X)=TQUE:NEXT X:RETURN
  185. 8800 TUNE=QUE(1):IF TUNE=0 THEN GOSUB 8700:STRAC=1:ETRAC=53:RETURN:' @Que
  186. 8810 DEC=TUNE:GOSUB 5000:STRAC=BCD:ETRAC=BCD:GOSUB 8820:GOSUB 8840:RETURN
  187. 8820 TUNE=QUE(1):FOR X=1 TO MQUE-1:QUE(X)=QUE(X+1):NEXT X:QUE(MQUE)=TUNE:RETURN
  188. 8830 TUNE=QUE(MQUE):FOR X=MQUE TO 2 STEP -1:QUE(X)=QUE(X-1):NEXT X:QUE(1)=TUNE:RETURN
  189. 8839 LOCATE 14,38:PRINT "Que";
  190. 8840 LOCATE 14,41:PRINT QUE(1);"  ";:RETURN
  191. 9000 GOSUB 2000:GOSUB 10900:GOSUB 8000:GOSUB 5500
  192. 9100 GOSUB 4000:IF DSTAT>31 THEN GOSUB 9600
  193. 9110 IF WF=0 THEN IF DSTAT=8 THEN K$="P"
  194. 9116 IF LEN(K$)>1 THEN GOSUB 6300
  195. 9120 IF K$<>"" THEN GOSUB 9200
  196. 9130 IF OLDDISC=0 THEN GOSUB 5500
  197. 9199 GOTO 9100
  198. 9200 IF K$="{" THEN INC=-1:GOSUB 7950
  199. 9210 IF K$="}" THEN INC=1:GOSUB 7950
  200. 9220 IF K$="[" THEN INC=-10:GOSUB 7900:RETURN
  201. 9230 IF K$="]" THEN INC=10:GOSUB 7900:RETURN
  202. 9240 IF K$=" " THEN GOSUB 7710
  203. 9242 IF QFLAG=1 THEN GOSUB 9330
  204. 9250 IF K$=";" OR K$=">" OR K$="." THEN SKIPDIR=1:GOSUB 7100
  205. 9260 IF K$=":" OR K$="<" OR K$="," THEN SKIPDIR=-1:GOSUB 7100
  206. 9270 GOSUB 9660:IF K$="C" THEN GOSUB 7800
  207. 9280 IF K$="B" THEN GOSUB 7300
  208. 9290 IF K$="F" THEN GOSUB 7400
  209. 9300 IF K$="/" THEN GOSUB 8700
  210. 9304 IF K$="S" THEN GOSUB 9900:GOSUB 7060:IF K$="" THEN GOSUB 9400
  211. 9306 IF K$="P" THEN GOSUB 9560:WF=0:GOSUB 9400
  212. 9308 IF K$="R" THEN GOSUB 7060:TIP=LMAGENTA:RFLAG=1:GOSUB 9500:GOSUB 4400
  213. 9310 IF K$="N" OR K>47 AND K<58 THEN GOSUB 7060:GOSUB 9500
  214. 9312 IF K$="M" THEN GOSUB 8200
  215. 9314 IF K$="T" THEN GOSUB 8700
  216. 9318 IF K$="I" THEN GOSUB 9970
  217. 9320 IF K$="D" THEN GOSUB 9800
  218. 9322 IF K$="Q" THEN GOSUB 3950:GOSUB 10600:COLOR INK,BLACK:CLS:SYSTEM
  219. 9326 FOR X=0 TO 6:J$=INKEY$:NEXT X:X=RND(1)
  220. 9329 RETURN
  221. 9330 IF K$="," OR K$="<" THEN SKIPDIR=-1:GOSUB 8500
  222. 9340 IF K$="." OR K$=">" THEN SKIPDIR=1:GOSUB 8500
  223. 9342 RETURN
  224. 9350 GOSUB 9660:GOSUB 9330
  225. 9352 IF K$="D" THEN GOSUB 8400
  226. 9354 IF K$="I" OR K>47 AND K<58 THEN GOSUB 8300
  227. 9356 IF K$="F" THEN MQUE=MAXTRAC:GOSUB 8720
  228. 9358 IF K$="S" THEN IF MQUE>2 THEN GOSUB 8730
  229. 9360 IF K$="C" THEN MQUE=1:QUE(1)=0:QFLAG=0
  230. 9362 IF K$="T" THEN GOSUB 8700
  231. 9399 GOSUB 9326:K$="M":RETURN
  232. 9400 IF OLDDISC=0 THEN GOSUB 5500:' \ Play
  233. 9410 IF RFLAG=1 THEN GOSUB 3200:RETURN
  234. 9420 IF FINFLAG=1 THEN GOSUB 3300:RETURN
  235. 9430 IF QFLAG=1 THEN GOSUB 8800:GOSUB 3200:RETURN
  236. 9450 GOSUB 5100:GOSUB 3300:RETURN
  237. 9460 FOR X=1 TO 6:HTIM(X)=0:NEXT:HTIM(4)=99:GOSUB 3400:IF DSTAT=4 THEN GOSUB 5200:FOR X=1 TO 3:HTIM(X)=QCODE(X+7):NEXT
  238. 9470 RETURN
  239. 9500 GOSUB 9560:PRINT "Starting Track: ";:GOSUB 6200:STRAC=VAL(WK$):' #Play
  240. 9510 IF STRAC<1 THEN STRAC=1 ELSE IF STRAC>MAXTRAC THEN 9500
  241. 9520 GOSUB 9560:PRINT "  Ending Track: ";:GOSUB 6200:ETRAC=VAL(WK$)
  242. 9530 IF ETRAC<1 THEN ETRAC=99
  243. 9532 IF ETRAC<STRAC THEN T=STRAC:STRAC=ETRAC:ETRAC=T
  244. 9540 DEC=STRAC:GOSUB 5000:STRAC=BCD:DEC=ETRAC:GOSUB 5000:ETRAC=BCD
  245. 9550 GOSUB 9560:GOSUB 3200:RETURN
  246. 9560 LOCATE 23,30:COLOR INK:PRINT BLK$;:LOCATE 23,30:RETURN
  247. 9600 K$=INKEY$:IF K$<>"" THEN GOSUB 9660:' \ Error?
  248. 9610 GOSUB 3010:GOSUB 3400:IF DSTAT=8 THEN RETURN:' Pause
  249. 9620 IF DSTAT>127 THEN GOSUB 9760:GOTO 9600
  250. 9630 IF DSTAT>63 THEN GOSUB 9700
  251. 9640 IF DSTAT=4 THEN RETURN:' Play
  252. 9650 GOTO 9600
  253. 9660 K=ASC(K$):IF K>96 AND K<123 THEN K=K-32:K$=CHR$(K)
  254. 9670 IF K$="A" AND DT=51 THEN GOSUB 3400:IF DSTAT>63 THEN GOSUB 3920:' Eat
  255. 9680 IF K$="E" THEN GOSUB 7060:GOSUB 9880:' Eject
  256. 9682 IF K=27 THEN LOCATE 19:GOSUB 10600:STOP
  257. 9690 RETURN
  258. 9700 GOSUB 9560:OLDDISC=0:CDRST=0:PRINT " Insert Disc!":GOSUB 9740:GOSUB 9860
  259. 9710 FOR T=1 TO 400:NEXT T:GOSUB 9720:RETURN
  260. 9720 GOSUB 9560:FOR T=1 TO 100:NEXT T:RETURN
  261. 9730 GOSUB 9560:PRINT" Bad Disc? Dirty?":BEEP:FOR X=0 TO 4500:NEXT:RETURN
  262. 9740 FOR X=5 TO 12:LOCATE X,42:PRINT "   ";:NEXT X
  263. 9750 COLOR GREY,HOLE:FOR X=1 TO 80:LOCATE SPOS,X:PRINT SCALE$;:NEXT:COLOR INK,PAPER:RETURN
  264. 9760 IF CDRST<1 THEN GOSUB 3900:CDRST=1:RETURN
  265. 9770 GOSUB 9880:GOSUB 9730:RETURN
  266. 9800 GOSUB 9560:PRINT "Drive Number? ";:GOSUB 6000:IF K>47 AND K<56 THEN T=VAL(K$) ELSE GOTO 9800
  267. 9810 GOSUB 9560:IF T=DRIVE THEN RETURN
  268. 9820 DF=0:DRIVE=T:OLDDISC=0:GOSUB 9890:GOSUB 8000:GOSUB 9850:RETURN
  269. 9850 GOSUB 3700:DT=ID(52):RETURN
  270. 9860 IF DT=67 THEN RETURN
  271. 9862 GOSUB 3400:CHUCK=DSTAT AND 64:COLOR INK,HOLE:LOCATE 16,46:IF CHUCK=64 THEN PRINT "Accept":KEY 9,"A"
  272. 9864 IF CHUCK=0 THEN PRINT "Eject ":KEY 9,"E"
  273. 9870 COLOR INK,PAPER:RETURN
  274. 9880 GOSUB 3950:GOSUB 3960:RETURN
  275. 9890 DVAR=DRIVE*8:DVAR=DVAR XOR 32:CMD=129 OR DVAR:DMC=131 OR DVAR:NOCMD=128 OR DVAR:NODMC=130 OR DVAR:RETURN
  276. 9900 GOSUB 7060:TIP=LBLUE:GOSUB 4400:Z=1:STIM=17:' Sample
  277. 9910 DEC=Z:GOSUB 5000:STRAC=BCD:ETRAC=153:GOSUB 3200
  278. 9920 GOSUB 9940:IF K$<>"" THEN RETURN
  279. 9930 Z=Z+1:IF Z>MAXTRAC THEN RETURN ELSE 9910:' Exit
  280. 9940 GOSUB 5200:GOSUB 4200:K$=INKEY$:IF K$<>"" THEN RETURN
  281. 9950 BCD=QCODE(5):GOSUB 5050:IF DEC<STIM THEN 9940
  282. 9960 RETURN
  283. 9970 ID$="":FOR Q=1 TO 52:ID$=ID$+CHR$(ID(Q)):NEXT :LOCATE 23,14:PRINT ID$
  284. 9980 FOR X=0 TO 9999:NEXT:LOCATE 23,14:PRINT BLK$;BLK$:RETURN
  285. 9990 FOR X=0 TO 100:J$=INKEY$:NEXT:RETURN
  286. 10000 KEY OFF:' \ Setup
  287. 10010 PRTA=&H300:' Program Card-Address
  288. 10020 PRTB=PRTA+1:PRTC=PRTA+2:DIRPRT=PRTA+3:NCMD=&H92:OTCMD=&H82:DRIVE=0
  289. 10030 GOSUB 9890:DIM QCODE(10),PTIM(6),HTIM(6),MTIM(6),RTIM(6),ID(52),QUE(100)
  290. 10040 CHANNELS=0:DF=0:SPOS=20:TIP$=CHR$(4):SCALE$=CHR$(254)
  291. 10060 BLUE=1:GREEN=2:CYAN=3:RED=4:MAGENTA=5:BROWN=6:WHITE=7:FLASH=16
  292. 10070 LBLUE=9:LGREEN=10:LCYAN=11:LRED=12:LMAGENTA=13:YELLOW=14:LWHITE=15:GREY=8
  293. 10080 PAPER=GREEN:INK=LWHITE:HOLE=BLACK:TIP=YELLOW
  294. 10100 TOP$=CHR$(218):FOR X=2 TO 79:TOP$=TOP$+CHR$(196):NEXT X:TOP$=TOP$+CHR$(191)
  295. 10110 BOT$=TOP$:MID$(BOT$,1,1)=CHR$(192):MID$(BOT$,80,1)=CHR$(217)
  296. 10120 CET$=CHR$(179):FOR X=2 TO 79:CET$=CET$+" ":NEXT X:CET$=CET$+CHR$(179)
  297. 10200 KEY 1,"<":KEY 2,">":KEY 3,"{":KEY 4,"}":KEY 5,"[":KEY 6,"]":KEY 7,"P":KEY  8,"N":KEY 9,"E":KEY 10,"S"
  298. 10210 FCN$=" <  >    <<<  >>>   <<  >>   Play  Number  Eject  Sample   Cue   Pause  Quit"
  299. 10220 KFN$="F1  F2    F3  F4    F5  F6    F7     F8      F9     F10     C    -----   Q"
  300. 10250 BLK$="                           "
  301. 10260 MTIM(1)=0:MTIM(2)=0:MTIM(3)=0:MTIM(4)=153:MTIM(5)=89:MTIM(6)=116
  302. 10280 TITLE$="Romplay - Ver. 0.75e"
  303. 10500 RETURN
  304. 10600 OUT PRTA,255:OUT PRTC,223:RETURN
  305. 10900 COLOR INK,PAPER:CLS
  306. 10910 PRINT TOP$;CET$;BOT$:LOCATE 2,30:PRINT TITLE$;
  307. 10920 LOCATE 5,34:PRINT "Tracks"
  308. 10930 LOCATE 6,34:PRINT "Minutes":LOCATE 7,34:PRINT"Seconds";
  309. 10940 LOCATE 9,35:PRINT "Track":LOCATE 10,35:PRINT"Index"
  310. 10950 LOCATE 11,35:PRINT "Minute":LOCATE 12,35:PRINT "Second"
  311. 10960 COLOR ,HOLE:LOCATE 15:PRINT TOP$;CET$;CET$;BOT$;
  312. 10970 LOCATE 16,3:PRINT FCN$;:LOCATE 17,3:PRINT KFN$;:COLOR INK,PAPER:RETURN
  313. 32000 ' \ Romplay by Roscoe 71777,2564
  314. 32001 ' \ Hardware Direct - Hitachi CDR1503S/3500 CD-ROM Drives/PC bus
  315. 32002 ' \ twr15Jul89
  316.